home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0041_Moonphase Algorithm?.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  2KB  |  65 lines
  1. {
  2. As Robert Forbes said to All on 25 Apr 94...
  3.  
  4.  RF>         Anyone have any idea how to make an algorithm to
  5.  RF> calculate the moonphase given the date?
  6.  
  7. Here ya go:
  8.  
  9. TYPE DATETYPE = record
  10.      day:WORD;
  11.      MONTH:WORD;
  12.      YEAR:WORD;
  13.      dow:word;
  14.      end;
  15.  
  16. {=================================================================}
  17.  
  18. Procedure GregorianToJulianDN(Year, Month, Day:Integer;
  19.                               var JulianDN    :LongInt);
  20. var
  21.   Century,
  22.   XYear    : LongInt;
  23.  
  24. begin {GregorianToJulianDN}
  25.   If Month <= 2 then begin
  26.     Year := pred(Year);
  27.     Month := Month + 12;
  28.     end;
  29.   Month := Month - 3;
  30.   Century := Year div 100;
  31.   XYear := Year mod 100;
  32.   Century := (Century * D1) shr 2;
  33.   XYear := (XYear * D0) shr 2;
  34.   JulianDN := ((((Month * 153) + 2) div 5) + Day) + D2
  35.                                     + XYear + Century;
  36.   end; {GregorianToJulianDN}
  37.  
  38. {=================================================================}
  39.  
  40. Function MoonPhase(Date:Datetype):Real;
  41.  
  42.   (***************************************************************)
  43.   (*                                                             *)
  44.   (* Determines APPROXIMATE phase of the moon (percentage lit)   *)
  45.   (* 0.00 = New moon, 1.00 = Full moon                           *)
  46.   (* Due to rounding, full values may possibly never be reached  *)
  47.   (* Valid from Oct. 15, 1582 to Feb. 28, 4000                   *)
  48.   (* Calculations and BASIC program found in                     *)
  49.   (* "119 Practical Programs For The TRS-80 Pocket Computer" by  *)
  50.   (* John Clark Craig, TAB Books, 1982                           *)
  51.   (* Conversion to Turbo Pascal by Alan Graff, Wheelersburg, OH  *)
  52.   (*                                                             *)
  53.   (***************************************************************)
  54.  
  55. var
  56. j:longint; m:real;
  57.  
  58. Begin
  59.   GregorianToJulianDN(Date.Year,Date.Month,Date.Day,J);
  60.   M:=(J+4.867)/ 29.53058;
  61.   M:=2*(M-Int(m))-1;
  62.   MoonPhase:=Abs(M);
  63. end;
  64.  
  65.